home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Network Support Library
/
RoseWare - Network Support Library.iso
/
apidev
/
basnet.arc
/
PIPES.BAS
< prev
next >
Wrap
BASIC Source File
|
1987-04-21
|
10KB
|
253 lines
1 ' pipes
2 '
3 ' demonstates the creation of a communication
4 ' pipeline using NetWare Function E1h(04,05,06,07 and 08)
5 '
10 GOSUB 10000
100 CLS
110 PRINT "******************** MENU *******************"
120 PRINT " 1. Generate station list
130 PRINT " 2. Open pipe with station list
140 PRINT " 3. Send messages to station list
150 PRINT " 4. Retrieve message from pipe message queue
160 PRINT " 5. Check pipe status with station list
170 PRINT " 6. Close pipes with station list
172 PRINT
175 PRINT " 7. Send broadcast to station list
178 PRINT " 8. Set broadcast mode
180 PRINT "*********************************************"
190 PRINT
200 INPUT "Select: ",V$
210 IF V$ = "" THEN 9999
220 V% = VAL(V$)
230 ON V% GOTO 300,1000,2000,3000,4000,5000,6000,7000
240 GOTO 100
300 '
310 ' GENERATE A STATION LIST TO OPEN PIPES TO
320 ' AND LOAD THE NUMSTATIONS$ PARAMETER
330 CLS
336 DEF SEG = LIBSEG
340 PRINT "LIST OF ACTIVE STATIONS
345 PRINT "Station # UserName"
350 FOR I% = 1 TO 100
360 REQ$ = CHR$(2)+CHR$(0) + CHR$(22) + CHR$(I%)
365 REP$ = CHR$(62)+CHR$(0) + STRING$(62,0)
370 CALL SYSLOG(ERRCODE%,REQ$,REP$)
380 IF ASC(MID$(REP$,8,1)) = 1 THEN LOCATE ,5: PRINT USING "###";I%;: PRINT SPC(6)MID$(REP$,9,48)
390 NEXT I%
400 DEF SEG
530 PRINT "Enter the station number(s), one at a time, you wish "
540 PRINT "to establish communications with (just <enter> when done):"
550 STNCALL% = 1
554 STATIONLIST$ = ""
560 WHILE STNCALL% <> 0
562 INPUT; "=> ",TALKTO$: print " ";
564 STNCALL% = VAL(TALKTO$)
566 IF STNCALL% <> 0 THEN STATIONLIST$ = STATIONLIST$ + CHR$(STNCALL%)
568 WEND
570 NUMSTATIONS$ = CHR$(LEN(STATIONLIST$)): NUMSTN% = ASC(NUMSTATIONS$)
580 GOTO 100
1000 ' OPEN A PIPE
1010 FUNCTION$ = CHR$(6) ' function 6 - open pipe
1020 GOSUB 9000 ' make the request and reply buffers and the call
1050 IF ERRCODE% <> 0 THEN INPUT "Function incomplete <enter> ",V$: GOTO 100
1055 GOSUB 8000
1060 PRINT "(0 = pipe complete, 254 = one side complete, 255 = station not in use)
1070 INPUT " <enter> ",V$: GOTO 100
2000 ' ROUTINE TO SEND A MESSAGE
2010 PRINT
2015 LINE INPUT;"Enter a message to send (max. 126 chars): "; MSG$
2020 IF MSG$ = "" THEN GOTO 100
2035 FUNC$ = CHR$(4)
2060 MESSAGELEN$ = CHR$(LEN(MSG$))
2070 REQUEST$ = FUNC$ + NUMSTATIONS$ + STATIONLIST$ + MESSAGELEN$ + MSG$
2075 REQUEST$ = CHR$(LEN(REQUEST$)) + CHR$(0) + REQUEST$
2080 REPLY$ = CHR$(101)+CHR$(0) + STRING$(101,0)
2090 DEF SEG = LIBSEG
2100 CALL PIPREQ(ERRCODE%, REQUEST$, REPLY$)
2110 DEF SEG
2115 PRINT
2120 IF ERRCODE% <> 0 THEN PRINT "<Unable to send message.>": GOTO 2010
2122 GOSUB 8000
2124 PRINT "(0 = Sent, 252 = Pipe full, 253 = invalid station, 255 = pipe not active)": GOTO 2010
3000 ' GET A MESSAGE FROM THE PIPE QUEUE
3010 REQUEST$ = CHR$(1) + CHR$(0) + CHR$(5): MSGLNGTH% = 1
3015 DEF SEG = LIBSEG
3020 WHILE MSGLNGTH% <> 0
3030 REPLY$ = CHR$(130) + STRING$(131,0)
3040 CALL PIPREQ(ERRCODE%, REQUEST$, REPLY$)
3050 IF ERRCODE% <> 0 THEN PRINT "Error --> ",ERRCODE%
3060 STN% = ASC(MID$(REPLY$,3,1))
3065 MSGLNGTH% = ASC(MID$(REPLY$,4,1))
3070 MSG$ = MID$(REPLY$,5,MSGLNGTH%)
3080 IF MSGLNGTH% <> 0 THEN PRINT "from "STN%"- "MSG$
3090 WEND
3095 DEF SEG
3100 INPUT "No more messages. <enter> ",V$: GOTO 100
4000 ' CHECK IF PIPES TO STATIONLIST ARE OPEN
4010 PRINT
4045 FUNCTION$ = CHR$(8)
4046 GOSUB 9000
4050 GOSUB 8000
4120 INPUT "(255 = pipe incomplete, 0 = pipe open at both ends) <enter>",V$: GOTO 100
5000 'close the pipe and exit
5045 FUNCTION$ = CHR$(7)
5046 GOSUB 9000
5110 GOSUB 8000
5120 INPUT "(253 = Invalid station, 0 = Pipe closed) <enter>",V$: GOTO 100
6000 ' SEND A BROADCAST TO STATIONLIST
6010 PRINT
6020 INPUT "Message to broadcast (max. 60 chars): ",MESSAGE$
6030 IF MESSAGE$ = "" THEN GOTO 100
6034 FUNC$ = CHR$(0)
6036 MESSAGELEN$ = CHR$(LEN(MESSAGE$))
6040 REQUEST$ = FUNC$ + NUMSTATIONS$ + STATIONLIST$ + MESSAGELEN$ + MESSAGE$
6050 REQUEST$ = CHR$(LEN(REQUEST$)) + CHR$(0) + REQUEST$
6060 REPLY$ = CHR$(101)+CHR$(0) + STRING$(101,0)
6070 DEF SEG = LIBSEG
6080 CALL PIPREQ(RETCODE%, REQUEST$, REPLY$)
6090 DEF SEG
6100 IF RETCODE% <> 0 THEN PRINT "Unable to send successfully.": goto 6000
6110 GOSUB 8000
6120 PRINT "(0 = logged for forwarding, 252 = broadcast queue in use, 255 = not logged) ": goto 6000
7000 'SET BROADCAST MODE AND RETRIEVE MESSAGES SAVED
7010 PRINT: INPUT "'R'etreive a message, 'S'elect mode, or 'E'xit: ",BUF$
7011 IF ASC(BUF$) > 90 THEN BUF$ = CHR$(ASC(BUF$) - 32)
7013 IF BUF$ = "S" THEN GOTO 7200
7015 IF BUF$ <> "R" THEN GOTO 100
7030 REQUEST$ = CHR$(1) + CHR$(0) + CHR$(1)
7040 REPLY$ = CHR$(61) + CHR$(0) + STRING$(61,CHR$(0))
7050 DEF SEG = LIBSEG
7060 CALL PIPREQ(ERRCODE%, REQUEST$, REPLY$)
7070 DEF SEG
7080 IF MID$(REPLY$,3,1) = CHR$(0) THEN GOTO 7010
7082 PRINT "Message retrieved: "MID$(REPLY$,4,ASC(MID$(REPLY$,3,1)))
7090 GOTO 7010
7200 ' select broadcast mode
7220 PRINT: INPUT "Select broadcast receive mode:(0=all,1=console,2=none,3=store) ",MODE$
7230 MODE% = VAL(MODE$)
7250 DEF SEG = LIBSEG
7260 CALL BCSMODE(MODE%)
7270 DEF SEG
7280 PRINT "new mode is "mode%
7285 GOTO 7010
8000 'PRINT OUT THE STATIONLIST AND STATUS
8015 PRINT "Stationlist: ";
8020 FOR I% = 1 TO NUMSTN%
8030 PRINT USING "### ";ASC(MID$(STATIONLIST$,I%,1));
8040 NEXT I%
8041 PRINT: PRINT "Status: ";
8080 FOR I% = 1 TO NUMSTN%
8090 PRINT USING "### ";ASC(MID$(REPLY$,I%+3,1));
8100 NEXT I%
8110 PRINT
8120 RETURN
9000 '
9010 ' make request buffer and reply buffer
9020 '
9030 REQUEST$ = FUNCTION$ + NUMSTATIONS$ + STATIONLIST$
9100 REQUEST$ = CHR$(LEN(REQUEST$)) + CHR$(0) + REQUEST$
9110 REPLY$ = CHR$(101)+CHR$(0) + STRING$(101,0)
9112 DEF SEG = LIBSEG
9114 CALL PIPREQ(ERRCODE%, REQUEST$, REPLY$)
9116 DEF SEG
9120 RETURN
9999 SYSTEM
10000 '
10010 ' routines for network use
10020 '
10100 ' This section contains the routine names and
10101 ' offsets for the BASNET library
10102 ' the return is after everything is set up for NetWare calls
10110 XTNDOPN = 0 'xtndopn(Mode%, Filename$, Handle%, ErrCode%)
10111 SETATTR = 3 'setattr(Func%, Filename$, Attribute%, ErrCode%)
10112 EOJSTAT = 6 'eojstat(Flag%)
10113 PRLH.LOG = 9 'PRLH.Log(FileHandle%,HiByteOffset%,LoByteOffset%,HiLockLen%,LoLockLen%,Flags%,TimeOut%,ErrCode%)
10114 PRLH.REL = 12 'PRLH.Rel(FileHandle%,HiByteOffset%,LoByteOffset%,ErrCode%)
10115 PRLH.CLR = 15 'PRLH.Clr(FileHandle%,HiByteOffset%,LoByteOffset%,Errcode%)
10116 PRLF.LOG = 18 'PRLF.Log(fcb%,HiByteOffset%,LoByteOffset%,HiLockLen%,LoLockLen%,Flags%,TimeOut%,ErrCode%)
10117 PRLF.REL = 21 'PRLF.Rel(fcb%,HiByteOffset%,LoByteOffset%,ErrCode%)
10118 PRLF.CLR = 24 'PRLF.Clr(fcb%,HiByteOffset%,LoByteOffset%,ErrCode%)
10119 PRLS.LCK = 27 'PRLS.Lck(Flags%,TimeOut%,ErrCode%)
10120 PRLS.REL = 30 'PRLS.Rel(ErrCode%)
10121 PRLS.CLR = 33 'PRLS.Clr(ErrCode%)
10122 OPENSEM = 36 'OpenSem(Sema4$,SemaValu%,HiHandle%,LoHandle%,OpenCnt%,RetCode%)
10123 EXAMSEM = 39 'ExamSem(HiHandle%,LoHandle%,SemaValu%,OpenCnt%,RetCode%)
10124 WAITSEM = 42 'WaitSem(HiHandle%,LoHandle%,TimeOut%,RetCode%)
10125 SIGSEM = 45 'SigSem(HiHandle%,LoHandle%,RetCode%)
10126 CLOSSEM = 48 'ClosSem(HiHandle%,LoHandle%,RetCode%)
10127 SETLCK = 51 'setlck(Func%,Mode%)
10128 BAKOUTS = 54 'Bakouts(Func%,RetCode%)
10129 BTRANS = 57 'btran(ReturnCode%, Mode%)
10130 ETRANS = 60 'etrans(ReturnCode%)
10131 EXCLOG = 63 'exclog(ReturnCode%, FcbAddr)
10132 EXCLCKS = 66 'exclcks(ReturnCode%, Mode%)
10133 EXCULKF = 69 'exculkf(ReturnCode%, FcbAddr)
10134 EXCULKS = 72 'exculks(ReturnCode%)
10135 EXCCLRF = 75 'excclrf(ReturnCode%, FcbAddr)
10136 EXCCLRS = 78 'excclrs(ReturnCode%)
10137 RECLOG = 81 'reclog(ReturnCode%, String$)
10138 RECLCK = 84 'reclck(ReturnCode%, Mode%)
10139 RECULK = 87 'reculk(ReturnCode%, Semaphore$)
10140 RECULKS = 90 'reculks(ReturnCode%)
10141 RECCLR = 93 'recclr(ReturnCode%, Semaphore$)
10142 RECCLRS = 96 'recclrs(ReturnCode%)
10143 EOJ = 99 'eoj(ReturnCode%)
10144 SYSOUT = 102 'sysout(ReturnCode%)
10145 ALLOCR = 105 'allocr(ReturnCode%, Resource%)
10146 DALLOCR = 108 'dallocr(ReturnCode%, Resource%)
10147 VOLSTAT = 111 'volstat(volume%, reply$)
10148 LOCDRV = 114 'locdrv(NumDisks%)
10149 WSID = 117 'wsid(ThisStationNum%)
10150 ERRMODE = 120 'errmode(mode%)
10151 BCSMODE = 123 'bcsmode(mode%)
10152 CTLSPL = 126 'ctlspl(mode%)
10153 SPLREQ = 129 'splreq(ErrCode%, RequestBlock$, Reply$)
10154 PIPREQ = 132 'pipreq(ErrCode%, RequestBlock$, Reply$)
10155 DPATH = 135 'dpath(ReturnCode%, RequestBlock$, Reply$)
10156 SYSLOG = 138 'syslog(ReturnCode%, RequestBlock$, Reply$)
10157 FATTR = 141 'fattr(ReturnCode%, FcbAddr, Attribute%)
10158 UPDFCB = 144 'updfcb(RetCode%,FcbAddr)
10159 CPYFILE = 147 'cpyfile(ReturnCode%, FcbSource, FcbDest, CountLow, CountHigh)
10160 NETTOD = 150 'nettod(time$)
10161 CLSMODE = 153 'clsmode(mode%)
10162 DRVMAP = 156 'drvmap(ReturnFlags%, drive%)
10163 RETSHL = 159 'retshl(RetCode%, Mode%)
10164 ASCLOG = 162 'asclog(RetCode%, Asciiz$)
10165 ASCULKF = 165 'asculkf(RetCode%, Asciiz$)
10166 ASCCLRF = 168 'ascclrf(RetCode%, Asciiz$)
10167 GETPSN = 171 'Get_PSN(StationNo%)
10168 GETSTA = 174 'Get_STA(Mode%,Segment%,Offset%)
10169 SETSERV = 177 'SetServ(Mode%,NewServ%,CurrServ%)
10170 MODSERV = 180 'ModServ(Mode%,NewServ%,RetCode%)
10180 GETDRV = 183 'GetDrv(Drive%)
10200 '
10210 ' Assign the segment address for the library to the variable LibSeg
10220 '
10230 DEF SEG = 0
10240 SUBOFF = PEEK(&H4F0)+(256*PEEK(&H4F1))
10250 SUBSEG = PEEK(&H4F2)+(256*PEEK(&H4F3))
10260 LIBSEG = SUBSEG
10270 DEF SEG
10280 ' be sure the resident module is in place so we don't blow up
10290 IF LIBSEG = 0 OR SUBOFF <> 0 THEN input "The resident library is not loaded <enter> ",v$
10300 '
10310 ' set the error mode so its more informative
10320 DEF SEG = LIBSEG
10330 NEWMODE% = 1
10340 CALL ERRMODE(NEWMODE%)
10350 DEF SEG
10999 RETURN